home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
MYMUD21.ZIP
/
MMUD21.ZIP
/
SOURCE
/
SOURCE.ZIP
/
TIMER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-01-21
|
5KB
|
207 lines
{$I COPYRGHT.INC}
(*----------------------------------------------------------------------------*
Timer routines. Used to time the checks for online messages and
for the shutdown semaphore.
*---------------------------------------------------------------------------*)
Unit Timer;
Interface
Uses Dos;
Type TimeString = String[8];
TimerObject = Object
TimeOut : LongInt;
StartTime : LongInt;
_24Hour : Boolean;
Procedure SetEvent(TimeStr : TimeString);
Function EventTime(TimeStr : TimeString):LongInt;
Function TestTime(TimeStr : TimeString):Boolean;
Function TimeNow:LongInt;
Procedure SetTimer(TenthsOfSec : LongInt);
Function TimeUp:Boolean;
Function SecToGo:LongInt;
Function TimeToGo:TimeString;
End;
ClockObject = Object
StartTime : LongInt;
Procedure StartTimer;
Function GiveTime:TimeString;
End;
Implementation
Const DayTime : LongInt = 864000;
Function S(Number : LongInt;Size:Byte):String;
Var HStr : String[20];
Begin
Str(Number:Size,HStr);
S:=HStr;
End;
Function Str2Nr(S : String):Word;
Var Temp : Word;
Err : Integer;
Begin
Val(S,Temp,Err);
IF Err>0
Then Str2Nr:=0
Else Str2Nr:=Temp;
End;
Function TimerObject.TestTime(TimeStr : TimeString):Boolean;
Var S2 : String[2];
Begin
TestTime:=False;
S2:=Copy(TimeStr,1,2);
If Not (
(Str2Nr(S2) in [0..23]) And
(S2[1] in ['0'..'9']) And
(S2[2] in ['0'..'9'])
)
Then Exit;
S2:=Copy(TimeStr,4,2);
If Not (
(Str2Nr(S2) in [0..59]) And
(S2[1] in ['0'..'9']) And
(S2[2] in ['0'..'9'])
)
Then Exit;
TestTime:=True;
End;
Function TimerObject.EventTime(TimeStr : TimeString):LongInt;
Var H,M,S : Word;
Begin
H:=Str2Nr(Copy(TimeStr,1,2)); Delete(TimeStr,1,3);
M:=Str2Nr(Copy(TimeStr,1,2)); Delete(TimeStr,1,3);
S:=Str2Nr(Copy(TimeStr,1,2));
EventTime:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10);
End;
Function TimerObject.TimeNow:LongInt;
Var H,M,S,D : Word;
Begin
GetTime(H,M,S,D);
TimeNow:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10);
End;
Procedure TimerObject.SetEvent(TimeStr : TimeString);
Begin
TimeOut:=EventTime(TimeStr);
If TimeOut=0
Then TimeOut:=DayTime;
_24Hour:=(TimeOut>=DayTime);
If _24Hour
Then TimeOut:=TimeOut-DayTime;
End;
Procedure TimerObject.SetTimer(TenthsOfSec : LongInt);
Var H,M,S,D : Word;
Begin
GetTime(H,M,S,D);
TimeOut:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10)+(LongInt(D) Div 10);
TimeOut:=TimeOut+TenthsOfSec;
_24Hour:=(TimeOut>=DayTime);
If _24Hour
Then TimeOut:=TimeOut-DayTime;
End;
Function TimerObject.TimeUp:Boolean;
Var Test : LongInt;
H,M,S,D : Word;
Begin
GetTime(H,M,S,D);
Test:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10)+(LongInt(D) Div 10);
If _24Hour and (H>0)
Then Test:=Test-DayTime;
TimeUp:=Test>TimeOut;
End;
Function TimerObject.SecToGo:LongInt;
Var Test : LongInt;
H,M,S,D : Word;
Begin
GetTime(H,M,S,D);
Test:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10)+(LongInt(D) Div 10);
If _24Hour And (H>0)
Then Test:=Test-DayTime;
SecToGo:=(TimeOut-Test) Div 10;
End;
Function TimerObject.TimeToGo:TimeString;
Var Test : LongInt;
HStr : TimeString;
H,M,Sec,D : Word;
Step : Byte;
Begin
GetTime(H,M,Sec,D);
Test:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(Sec)*10)+(LongInt(D) Div 10);
If _24Hour And (H>0)
Then Test:=Test-DayTime;
Test:=(TimeOut-Test) Div 10;
H:=Test Div 3600;
Test:=Test mod 3600;
M:=Test Div 60;
Test :=Test Mod 60;
Sec:=Test;
HStr:= S(H,2)+ ':'+
S(M,2)+ ':'+
S(Sec,2);
For Step:=1 To Length(HStr) Do
If HStr[Step]=' '
Then HStr[Step]:='0';
TimeToGo:=HStr;
End;
Procedure ClockObject.StartTimer;
Var H,M,S,D : Word;
Begin
GetTime(H,M,S,D);
StartTime:=(LongInt(H)*3600)+(LongInt(M)*60)+(LongInt(S));
End;
Function ClockObject.GiveTime:TimeString;
Var CurrTime : Longint;
HStr : TimeString;
Step : Byte;
H,M,Sec,D : Word;
Begin
GetTime(H,M,Sec,D);
CurrTime:=(LongInt(H)*3600)+(LongInt(M)*60)+(LongInt(Sec));
CurrTime:=CurrTime-StartTime;
If CurrTime<0
Then Inc(CurrTime,(DayTime div 10));
H:=CurrTime Div 3600;
CurrTime:=CurrTime mod 3600;
M:=CurrTime Div 60;
CurrTime:=CurrTime Mod 60;
Sec:=CurrTime;
HStr:=S(H,2)+':'+S(M,2)+':'+S(Sec,2);
For Step:=1 To Length(HStr) Do
If HStr[Step]=' '
Then HStr[Step]:='0';
GiveTime:=HStr;
End;
End.